perm filename FPRINT.LSP[TIM,LSP] blob
sn#677333 filedate 1982-09-13 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Benchmark to print to a file.
C00004 ENDMK
Cā;
;;; Benchmark to print to a file.
(declare (fixsw t))
(defun init (m n atoms)
(let ((atoms (subst () () atoms)))
(do ((a atoms (cdr a)))
((null (cdr a)) (rplacd a atoms)))
(init1 m n atoms)))
(defun init1 (m n atoms)
(cond ((= m 0) (pop atoms))
(t (do ((i n (- i 2))
(a ()))
((< i 1) a)
(push (pop atoms) a)
(push (init1 (1- m) n atoms) a)))))
(declare (special test-atoms))
(setq test-atoms '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67
mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12
wxyzab23 xyzabc34 123456ab 234567bc 345678cd
456789de 567890ef 678901fg 789012gh 890123hi))
(declare (special test-pattern))
(setq test-pattern (init 6. 6. test-atoms))
(defun fprint ()
(cond ((probef "fprint.tst")
(deletef "fprint.tst")))
(let ((f (open "fprint.tst" '(out ascii))))
(print test-pattern f)
(close f)))
(cond ((probef "fprint.tst"))
(t
(let ((f (open "fprint.tst" '(out ascii))))
(print test-pattern f)
(close f))))
(include "timer.lsp")
(timer timit (fprint))